home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nnvirtual.el.z / nnvirtual.el
Encoding:
Text File  |  1998-05-21  |  26.1 KB  |  775 lines
  1. ;;; nnvirtual.el --- virtual newsgroups access for Gnus
  2. ;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: David Moore <dmoore@ucsd.edu>
  5. ;;    Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  6. ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  7. ;; Keywords: news
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; The other access methods (nntp, nnspool, etc) are general news
  29. ;; access methods.  This module relies on Gnus and can not be used
  30. ;; separately.
  31.  
  32. ;;; Code:
  33.  
  34. (require 'nntp)
  35. (require 'nnheader)
  36. (require 'gnus)
  37. (require 'nnoo)
  38. (require 'gnus-util)
  39. (require 'gnus-start)
  40. (require 'gnus-sum)
  41. (eval-when-compile (require 'cl))
  42.  
  43. (nnoo-declare nnvirtual)
  44.  
  45. (defvoo nnvirtual-always-rescan nil
  46.   "*If non-nil, always scan groups for unread articles when entering a group.
  47. If this variable is nil (which is the default) and you read articles
  48. in a component group after the virtual group has been activated, the
  49. read articles from the component group will show up when you enter the
  50. virtual group.")
  51.  
  52. (defvoo nnvirtual-component-regexp nil
  53.   "*Regexp to match component groups.")
  54.  
  55. (defvoo nnvirtual-component-groups nil
  56.   "Component group in this nnvirtual group.")
  57.  
  58.  
  59.  
  60. (defconst nnvirtual-version "nnvirtual 1.1")
  61.  
  62. (defvoo nnvirtual-current-group nil)
  63.  
  64. (defvoo nnvirtual-mapping-table nil
  65.   "Table of rules on how to map between component group and article number
  66. to virtual article number.")
  67.  
  68. (defvoo nnvirtual-mapping-offsets nil
  69.   "Table indexed by component group to an offset to be applied to article numbers in that group.")
  70.  
  71. (defvoo nnvirtual-mapping-len 0
  72.   "Number of articles in this virtual group.")
  73.  
  74. (defvoo nnvirtual-mapping-reads nil
  75.   "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
  76.  
  77. (defvoo nnvirtual-mapping-marks nil
  78.   "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
  79.  
  80. (defvoo nnvirtual-info-installed nil
  81.   "T if we have already installed the group info for this group, and shouldn't blast over it again.")
  82.  
  83. (defvoo nnvirtual-status-string "")
  84.  
  85. (eval-and-compile
  86.   (autoload 'gnus-cache-articles-in-group "gnus-cache"))
  87.  
  88.  
  89.  
  90. ;;; Interface functions.
  91.  
  92. (nnoo-define-basics nnvirtual)
  93.  
  94.  
  95. (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
  96.                          server fetch-old)
  97.   (when (nnvirtual-possibly-change-server server)
  98.     (save-excursion
  99.       (set-buffer nntp-server-buffer)
  100.       (erase-buffer)
  101.       (if (stringp (car articles))
  102.       'headers
  103.     (let ((vbuf (nnheader-set-temp-buffer
  104.              (get-buffer-create " *virtual headers*")))
  105.           (carticles (nnvirtual-partition-sequence articles))
  106.           (system-name (system-name))
  107.           cgroup carticle article result prefix)
  108.       (while carticles
  109.         (setq cgroup (caar carticles))
  110.         (setq articles (cdar carticles))
  111.         (pop carticles)
  112.         (when (and articles
  113.                (gnus-check-server
  114.             (gnus-find-method-for-group cgroup) t)
  115.                (gnus-request-group cgroup t)
  116.                (setq prefix (gnus-group-real-prefix cgroup))
  117.                ;; FIX FIX FIX we want to check the cache!
  118.                ;; This is probably evil if people have set
  119.                ;; gnus-use-cache to nil themselves, but I
  120.                ;; have no way of finding the true value of it.
  121.                (let ((gnus-use-cache t))
  122.              (setq result (gnus-retrieve-headers
  123.                        articles cgroup nil))))
  124.         (set-buffer nntp-server-buffer)
  125.         ;; If we got HEAD headers, we convert them into NOV
  126.         ;; headers.  This is slow, inefficient and, come to think
  127.         ;; of it, downright evil.  So sue me.  I couldn't be
  128.         ;; bothered to write a header parse routine that could
  129.         ;; parse a mixed HEAD/NOV buffer.
  130.         (when (eq result 'headers)
  131.           (nnvirtual-convert-headers))
  132.         (goto-char (point-min))
  133.         (while (not (eobp))
  134.           (delete-region (point)
  135.                  (progn
  136.                    (setq carticle (read nntp-server-buffer))
  137.                    (point)))
  138.  
  139.           ;; We remove this article from the articles list, if
  140.           ;; anything is left in the articles list after going through
  141.           ;; the entire buffer, then those articles have been
  142.           ;; expired or canceled, so we appropriately update the
  143.           ;; component group below.  They should be coming up
  144.           ;; generally in order, so this shouldn't be slow.
  145.           (setq articles (delq carticle articles))
  146.  
  147.           (setq article (nnvirtual-reverse-map-article cgroup carticle))
  148.           (if (null article)
  149.           ;; This line has no reverse mapping, that means it
  150.           ;; was an extra article reference returned by nntp.
  151.           (progn
  152.             (beginning-of-line)
  153.             (delete-region (point) (progn (forward-line 1) (point))))
  154.         ;; Otherwise insert the virtual article number,
  155.         ;; and clean up the xrefs.
  156.         (princ article nntp-server-buffer)
  157.         (nnvirtual-update-xref-header cgroup carticle
  158.                           prefix system-name)
  159.         (forward-line 1))
  160.           )
  161.  
  162.         (set-buffer vbuf)
  163.         (goto-char (point-max))
  164.         (insert-buffer-substring nntp-server-buffer))
  165.         ;; Anything left in articles is expired or canceled.
  166.         ;; Could be smart and not tell it about articles already known?
  167.         (when articles
  168.           (gnus-group-make-articles-read cgroup articles))
  169.         )
  170.  
  171.       ;; The headers are ready for reading, so they are inserted into
  172.       ;; the nntp-server-buffer, which is where Gnus expects to find
  173.       ;; them.
  174.       (prog1
  175.           (save-excursion
  176.         (set-buffer nntp-server-buffer)
  177.         (erase-buffer)
  178.         (insert-buffer-substring vbuf)
  179.         ;; FIX FIX FIX, we should be able to sort faster than
  180.         ;; this if needed, since each cgroup is sorted, we just
  181.         ;; need to merge
  182.         (sort-numeric-fields 1 (point-min) (point-max))
  183.         'nov)
  184.         (kill-buffer vbuf)))))))
  185.  
  186.  
  187. (defvoo nnvirtual-last-accessed-component-group nil)
  188.  
  189. (deffoo nnvirtual-request-article (article &optional group server buffer)
  190.   (when (nnvirtual-possibly-change-server server)
  191.     (if (stringp article)
  192.     ;; This is a fetch by Message-ID.
  193.     (cond
  194.      ((not nnvirtual-last-accessed-component-group)
  195.       (nnheader-report
  196.        'nnvirtual "Don't know what server to request from"))
  197.      (t
  198.       (save-excursion
  199.         (when buffer
  200.           (set-buffer buffer))
  201.         (let ((method (gnus-find-method-for-group
  202.                nnvirtual-last-accessed-component-group)))
  203.           (funcall (gnus-get-function method 'request-article)
  204.                article nil (nth 1 method) buffer)))))
  205.       ;; This is a fetch by number.
  206.       (let* ((amap (nnvirtual-map-article article))
  207.          (cgroup (car amap)))
  208.     (cond
  209.      ((not amap)
  210.       (nnheader-report 'nnvirtual "No such article: %s" article))
  211.      ((not (gnus-check-group cgroup))
  212.       (nnheader-report
  213.        'nnvirtual "Can't open server where %s exists" cgroup))
  214.      ((not (gnus-request-group cgroup t))
  215.       (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
  216.      (t
  217.       (setq nnvirtual-last-accessed-component-group cgroup)
  218.       (if buffer
  219.           (save-excursion
  220.         (set-buffer buffer)
  221.         (gnus-request-article-this-buffer (cdr amap) cgroup))
  222.         (gnus-request-article (cdr amap) cgroup))))))))
  223.  
  224.  
  225. (deffoo nnvirtual-open-server (server &optional defs)
  226.   (unless (assq 'nnvirtual-component-regexp defs)
  227.     (push `(nnvirtual-component-regexp ,server)
  228.       defs))
  229.   (nnoo-change-server 'nnvirtual server defs)
  230.   (if nnvirtual-component-groups
  231.       t
  232.     (setq nnvirtual-mapping-table nil
  233.       nnvirtual-mapping-offsets nil
  234.       nnvirtual-mapping-len 0
  235.       nnvirtual-mapping-reads nil
  236.       nnvirtual-mapping-marks nil
  237.       nnvirtual-info-installed nil)
  238.     (when nnvirtual-component-regexp
  239.       ;; Go through the newsrc alist and find all component groups.
  240.       (let ((newsrc (cdr gnus-newsrc-alist))
  241.         group)
  242.     (while (setq group (car (pop newsrc)))
  243.       (when (string-match nnvirtual-component-regexp group) ; Match
  244.         ;; Add this group to the list of component groups.
  245.         (setq nnvirtual-component-groups
  246.           (cons group (delete group nnvirtual-component-groups)))))))
  247.     (if (not nnvirtual-component-groups)
  248.     (nnheader-report 'nnvirtual "No component groups: %s" server)
  249.       t)))
  250.  
  251.  
  252. (deffoo nnvirtual-request-group (group &optional server dont-check)
  253.   (nnvirtual-possibly-change-server server)
  254.   (setq nnvirtual-component-groups
  255.     (delete (nnvirtual-current-group) nnvirtual-component-groups))
  256.   (cond
  257.    ((null nnvirtual-component-groups)
  258.     (setq nnvirtual-current-group nil)
  259.     (nnheader-report 'nnvirtual "No component groups in %s" group))
  260.    (t
  261.     (when (or (not dont-check)
  262.           nnvirtual-always-rescan)
  263.       (nnvirtual-create-mapping))
  264.     (setq nnvirtual-current-group group)
  265.     (nnheader-insert "211 %d 1 %d %s\n"
  266.              nnvirtual-mapping-len nnvirtual-mapping-len group))))
  267.  
  268.  
  269. (deffoo nnvirtual-request-type (group &optional article)
  270.   (if (not article)
  271.       'unknown
  272.     (let ((mart (nnvirtual-map-article article)))
  273.       (when mart
  274.     (gnus-request-type (car mart) (cdr mart))))))
  275.  
  276. (deffoo nnvirtual-request-update-mark (group article mark)
  277.   (let* ((nart (nnvirtual-map-article article))
  278.      (cgroup (car nart))
  279.      ;; The component group might be a virtual group.
  280.      (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
  281.     (when (and nart
  282.            (= mark nmark)
  283.            (gnus-group-auto-expirable-p cgroup))
  284.       (setq mark gnus-expirable-mark)))
  285.   mark)
  286.  
  287.  
  288. (deffoo nnvirtual-close-group (group &optional server)
  289.   (when (and (nnvirtual-possibly-change-server server)
  290.          (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
  291.     (nnvirtual-update-read-and-marked t t))
  292.   t)
  293.  
  294.  
  295. (deffoo nnvirtual-request-list (&optional server)
  296.   (nnheader-report 'nnvirtual "LIST is not implemented."))
  297.  
  298.  
  299. (deffoo nnvirtual-request-newgroups (date &optional server)
  300.   (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
  301.  
  302.  
  303. (deffoo nnvirtual-request-list-newsgroups (&optional server)
  304.   (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
  305.  
  306.  
  307. (deffoo nnvirtual-request-update-info (group info &optional server)
  308.   (when (and (nnvirtual-possibly-change-server server)
  309.          (not nnvirtual-info-installed))
  310.     ;; Install the precomputed lists atomically, so the virtual group
  311.     ;; is not left in a half-way state in case of C-g.
  312.     (gnus-atomic-progn
  313.       (setcar (cddr info) nnvirtual-mapping-reads)
  314.       (if (nthcdr 3 info)
  315.       (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
  316.     (when nnvirtual-mapping-marks
  317.       (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
  318.       (setq nnvirtual-info-installed t))
  319.     t))
  320.  
  321.  
  322. (deffoo nnvirtual-catchup-group (group &optional server all)
  323.   (when (and (nnvirtual-possibly-change-server server)
  324.          (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
  325.     ;; copy over existing marks first, in case they set anything
  326.     (nnvirtual-update-read-and-marked nil nil)
  327.     ;; do a catchup on all component groups
  328.     (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
  329.       (gnus-expert-user t))
  330.       ;; Make sure all groups are activated.
  331.       (mapcar
  332.        (lambda (g)
  333.      (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
  334.        (gnus-activate-group g)))
  335.        nnvirtual-component-groups)
  336.       (save-excursion
  337.     (set-buffer gnus-group-buffer)
  338.     (gnus-group-catchup-current nil all)))))
  339.  
  340.  
  341. (deffoo nnvirtual-find-group-art (group article)
  342.   "Return the real group and article for virtual GROUP and ARTICLE."
  343.   (nnvirtual-map-article article))
  344.  
  345.  
  346. ;;; Internal functions.
  347.  
  348. (defun nnvirtual-convert-headers ()
  349.   "Convert HEAD headers into NOV headers."
  350.   (save-excursion
  351.     (set-buffer nntp-server-buffer)
  352.     (let* ((dependencies (make-vector 100 0))
  353.        (headers (gnus-get-newsgroup-headers dependencies))
  354.        header)
  355.       (erase-buffer)
  356.       (while (setq header (pop headers))
  357.     (nnheader-insert-nov header)))))
  358.  
  359.  
  360. (defun nnvirtual-update-xref-header (group article prefix system-name)
  361.   "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
  362.   ;; Move to beginning of Xref field, creating a slot if needed.
  363.   (beginning-of-line)
  364.   (looking-at
  365.    "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
  366.   (goto-char (match-end 0))
  367.   (unless (search-forward "\t" (gnus-point-at-eol) 'move)
  368.     (insert "\t"))
  369.  
  370.   ;; Remove any spaces at the beginning of the Xref field.
  371.   (while (= (char-after (1- (point))) ? )
  372.     (forward-char -1)
  373.     (delete-char 1))
  374.  
  375.   (insert "Xref: " system-name " " group ":")
  376.   (princ article (current-buffer))
  377.   (insert " ")
  378.  
  379.   ;; If there were existing xref lines, clean them up to have the correct
  380.   ;; component server prefix.
  381.   (save-restriction
  382.     (narrow-to-region (point)
  383.               (or (search-forward "\t" (gnus-point-at-eol) t)
  384.               (gnus-point-at-eol)))
  385.     (goto-char (point-min))
  386.     (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
  387.       (replace-match "" t t))
  388.     (goto-char (point-min))
  389.     (when (re-search-forward
  390.        (concat (gnus-group-real-name group) ":[0-9]+")
  391.        nil t)
  392.       (replace-match "" t t))
  393.     (unless (= (point) (point-max))
  394.       (insert " ")
  395.       (when (not (string= "" prefix))
  396.     (while (re-search-forward "[^ ]+:[0-9]+" nil t)
  397.       (save-excursion
  398.         (goto-char (match-beginning 0))
  399.         (insert prefix))))))
  400.  
  401.   ;; Ensure a trailing \t.
  402.   (end-of-line)
  403.   (or (= (char-after (1- (point))) ?\t)
  404.       (insert ?\t)))
  405.  
  406.  
  407. (defun nnvirtual-possibly-change-server (server)
  408.   (or (not server)
  409.       (nnoo-current-server-p 'nnvirtual server)
  410.       (nnvirtual-open-server server)))
  411.  
  412.  
  413. (defun nnvirtual-update-read-and-marked (read-p update-p)
  414.   "Copy marks from the virtual group to the component groups.
  415. If READ-P is not nil, update the (un)read status of the components.
  416. If UPDATE-P is not nil, call gnus-group-update-group on the components."
  417.   (when nnvirtual-current-group
  418.     (let ((unreads (and read-p
  419.             (nnvirtual-partition-sequence
  420.              (gnus-list-of-unread-articles
  421.               (nnvirtual-current-group)))))
  422.       (type-marks (mapcar (lambda (ml)
  423.                 (cons (car ml)
  424.                       (nnvirtual-partition-sequence (cdr ml))))
  425.                   (gnus-info-marks (gnus-get-info
  426.                         (nnvirtual-current-group)))))
  427.       mark type groups carticles info entry)
  428.  
  429.       ;; Ok, atomically move all of the (un)read info, clear any old
  430.       ;; marks, and move all of the current marks.  This way if someone
  431.       ;; hits C-g, you won't leave the component groups in a half-way state.
  432.       (gnus-atomic-progn
  433.     ;; move (un)read
  434.     (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles
  435.       (while (setq entry (pop unreads))
  436.         (gnus-update-read-articles (car entry) (cdr entry))))
  437.  
  438.     ;; clear all existing marks on the component groups
  439.     (setq groups nnvirtual-component-groups)
  440.     (while groups
  441.       (when (and (setq info (gnus-get-info (pop groups)))
  442.              (gnus-info-marks info))
  443.         (gnus-info-set-marks info nil)))
  444.  
  445.     ;; Ok, currently type-marks is an assq list with keys of a mark type,
  446.     ;; with data of an assq list with keys of component group names
  447.     ;; and the articles which correspond to that key/group pair.
  448.     (while (setq mark (pop type-marks))
  449.       (setq type (car mark))
  450.       (setq groups (cdr mark))
  451.       (while (setq carticles (pop groups))
  452.         (gnus-add-marked-articles (car carticles) type (cdr carticles)
  453.                       nil t))))
  454.  
  455.       ;; possibly update the display, it is really slow
  456.       (when update-p
  457.     (setq groups nnvirtual-component-groups)
  458.     (while groups
  459.       (gnus-group-update-group (pop groups) t))))))
  460.  
  461.  
  462. (defun nnvirtual-current-group ()
  463.   "Return the prefixed name of the current nnvirtual group."
  464.   (concat "nnvirtual:" nnvirtual-current-group))
  465.  
  466.  
  467.  
  468. ;;; This is currently O(kn^2) to merge n lists of length k.
  469. ;;; You could do it in O(knlogn), but we have a small n, and the
  470. ;;; overhead of the other approach is probably greater.
  471. (defun nnvirtual-merge-sorted-lists (&rest lists)
  472.   "Merge many sorted lists of numbers."
  473.   (if (null (cdr lists))
  474.       (car lists)
  475.     (sort (apply 'nconc lists) '<)))
  476.  
  477.  
  478. ;;; We map between virtual articles and real articles in a manner
  479. ;;; which keeps the size of the virtual active list the same as
  480. ;;; the sum of the component active lists.
  481. ;;; To achieve fair mixing of the groups, the last article in
  482. ;;; each of N component groups will be in the the last N articles
  483. ;;; in the virtual group.
  484.  
  485. ;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
  486. ;;; resprectively, then the virtual article numbers look like:
  487. ;;;
  488. ;;;  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15
  489. ;;;  A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
  490.  
  491. ;;; To compute these mappings we generate a couple tables and then
  492. ;;; do some fast operations on them.  Tables for the example above:
  493. ;;;
  494. ;;; Offsets - [(A 0) (B -3) (C -1)]
  495. ;;;
  496. ;;;               a  b  c  d  e
  497. ;;; Mapping - ([  3  0  1  3  0 ]
  498. ;;;            [  6  3  2  9  3 ]
  499. ;;;            [  8  6  3 15  9 ])
  500. ;;;
  501. ;;; (note column 'e' is different in real algorithm, which is slightly
  502. ;;;  different than described here, but this gives you the methodology.)
  503. ;;;
  504. ;;; The basic idea is this, when going from component->virtual, apply
  505. ;;; the appropriate offset to the article number.  Then search the first
  506. ;;; column of the table for a row where 'a' is less than or equal to the
  507. ;;; modified number.  You can see that only group A can therefore go to
  508. ;;; the first row, groups A and B to the second, and all to the last.
  509. ;;; The third column of the table is telling us the number of groups
  510. ;;; which might be able to reach that row (it might increase by more than
  511. ;;; 1 if several groups have the same size).
  512. ;;; Then column 'b' provides an additional offset you apply when you have
  513. ;;; found the correct row.  You then multiply by 'c' and add on the groups
  514. ;;; _position_ in the offset table.  The basic idea here is that on
  515. ;;; any given row we are going to map back and forth using X'=X*c+Y and
  516. ;;; X=(X'/c), Y=(X' mod c).  Then once you've done this transformation,
  517. ;;; you apply a final offset from column 'e' to give the virtual article.
  518. ;;;
  519. ;;; Going the other direction, you instead search on column 'd' instead
  520. ;;; of 'a', and apply everything in reverse order.
  521.  
  522. ;;; Convert component -> virtual:
  523. ;;; set num = num - Offset(group)
  524. ;;; find first row in Mapping where num <= 'a'
  525. ;;; num = (num-'b')*c + Position(group) + 'e'
  526.  
  527. ;;; Convert virtual -> component:
  528. ;;; find first row in Mapping where num <= 'd'
  529. ;;; num = num - 'e'
  530. ;;; group_pos = num mod 'c'
  531. ;;; num = (num / 'c') + 'b' + Offset(group_pos)
  532.  
  533. ;;; Easy no? :)
  534. ;;;
  535. ;;; Well actually, you need to keep column e offset smaller by the 'c'
  536. ;;; column for that line, and always add 1 more when going from
  537. ;;; component -> virtual.  Otherwise you run into a problem with
  538. ;;; unique reverse mapping.
  539.  
  540. (defun nnvirtual-map-article (article)
  541.   "Return a cons of the component group and article corresponding to the given virtual ARTICLE."
  542.   (let ((table nnvirtual-mapping-table)
  543.     entry group-pos)
  544.     (while (and table
  545.         (> article (aref (car table) 3)))
  546.       (setq table (cdr table)))
  547.     (when (and table
  548.            (> article 0))
  549.       (setq entry (car table))
  550.       (setq article (- article (aref entry 4) 1))
  551.       (setq group-pos (mod article (aref entry 2)))
  552.       (cons (car (aref nnvirtual-mapping-offsets group-pos))
  553.         (+ (/ article (aref entry 2))
  554.            (aref entry 1)
  555.            (cdr (aref nnvirtual-mapping-offsets group-pos)))
  556.         ))
  557.       ))
  558.  
  559.  
  560.  
  561. (defun nnvirtual-reverse-map-article (group article)
  562.   "Return the virtual article number corresponding to the given component GROUP and ARTICLE."
  563.   (let ((table nnvirtual-mapping-table)
  564.     (group-pos 0)
  565.     entry)
  566.     (while (not (string= group (car (aref nnvirtual-mapping-offsets
  567.                       group-pos))))
  568.       (setq group-pos (1+ group-pos)))
  569.     (setq article (- article (cdr (aref nnvirtual-mapping-offsets
  570.                     group-pos))))
  571.     (while (and table
  572.         (> article (aref (car table) 0)))
  573.       (setq table (cdr table)))
  574.     (setq entry (car table))
  575.     (when (and entry
  576.            (> article 0)
  577.            (< group-pos (aref entry 2))) ; article not out of range below
  578.       (+ (aref entry 4)
  579.      group-pos
  580.      (* (- article (aref entry 1))
  581.         (aref entry 2))
  582.      1))
  583.     ))
  584.  
  585.  
  586. (defsubst nnvirtual-reverse-map-sequence (group articles)
  587.   "Return list of virtual article numbers for all ARTICLES in GROUP.
  588. The ARTICLES should be sorted, and can be a compressed sequence.
  589. If any of the article numbers has no corresponding virtual article,
  590. then it is left out of the result."
  591.   (when (numberp (cdr-safe articles))
  592.     (setq articles (list articles)))
  593.   (let (result a i j new-a)
  594.     (while (setq a (pop articles))
  595.       (if (atom a)
  596.       (setq i a
  597.         j a)
  598.     (setq i (car a)
  599.           j (cdr a)))
  600.       (while (<= i j)
  601.     ;; If this is slow, you can optimize by moving article checking
  602.     ;; into here.  You don't have to recompute the group-pos,
  603.     ;; nor scan the table every time.
  604.     (when (setq new-a (nnvirtual-reverse-map-article group i))
  605.       (push new-a result))
  606.     (setq i (1+ i))))
  607.     (nreverse result)))
  608.  
  609.  
  610. (defun nnvirtual-partition-sequence (articles)
  611.   "Return an association list of component article numbers.
  612. These are indexed by elements of nnvirtual-component-groups, based on
  613. the sequence ARTICLES of virtual article numbers.  ARTICLES should be
  614. sorted, and can be a compressed sequence. If any of the article
  615. numbers has no corresponding component article, then it is left out of
  616. the result."
  617.   (when (numberp (cdr-safe articles))
  618.     (setq articles (list articles)))
  619.   (let ((carticles (mapcar (lambda (g) (list g))
  620.                nnvirtual-component-groups))
  621.     a i j article entry)
  622.     (while (setq a (pop articles))
  623.       (if (atom a)
  624.       (setq i a
  625.         j a)
  626.     (setq i (car a)
  627.           j (cdr a)))
  628.       (while (<= i j)
  629.     (when (setq article (nnvirtual-map-article i))
  630.       (setq entry (assoc (car article) carticles))
  631.       (setcdr entry (cons (cdr article) (cdr entry))))
  632.     (setq i (1+ i))))
  633.     (mapcar (lambda (x) (setcdr x (nreverse (cdr x))))
  634.         carticles)
  635.     carticles))
  636.  
  637.  
  638. (defun nnvirtual-create-mapping ()
  639.   "Build the tables necessary to map between component (group, article) to virtual article.
  640. Generate the set of read messages and marks for the virtual group
  641. based on the marks on the component groups."
  642.   (let ((cnt 0)
  643.     (tot 0)
  644.     (M 0)
  645.     (i 0)
  646.     actives all-unreads all-marks
  647.     active min max size unreads marks
  648.     next-M next-tot
  649.     reads beg)
  650.     ;; Ok, we loop over all component groups and collect a lot of
  651.     ;; information:
  652.     ;; Into actives we place (g size max), where size is max-min+1.
  653.     ;; Into all-unreads we put (g unreads).
  654.     ;; Into all-marks we put (g marks).
  655.     ;; We also increment cnt and tot here, and compute M (max of sizes).
  656.     (mapc (lambda (g)
  657.         (setq active (gnus-activate-group g)
  658.           min (car active)
  659.           max (cdr active))
  660.         (when (and active (>= max min) (not (zerop max)))
  661.           ;; store active information
  662.           (push (list g (- max min -1) max) actives)
  663.           ;; collect unread/mark info for later
  664.           (setq unreads (gnus-list-of-unread-articles g))
  665.           (setq marks (gnus-info-marks (gnus-get-info g)))
  666.           (when gnus-use-cache
  667.         (push (cons 'cache
  668.                 (gnus-cache-articles-in-group g))
  669.               marks))
  670.           (push (cons g unreads) all-unreads)
  671.           (push (cons g marks) all-marks)
  672.           ;; count groups, total #articles, and max size
  673.           (setq size (- max min -1))
  674.           (setq cnt (1+ cnt)
  675.             tot (+ tot size)
  676.             M (max M size))))
  677.       nnvirtual-component-groups)
  678.  
  679.     ;; Number of articles in the virtual group.
  680.     (setq nnvirtual-mapping-len tot)
  681.  
  682.  
  683.     ;; We want the actives list sorted by size, to build the tables.
  684.     (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
  685.  
  686.     ;; Build the offset table.  Largest sized groups are at the front.
  687.     (setq nnvirtual-mapping-offsets
  688.       (vconcat
  689.        (nreverse
  690.         (mapcar (lambda (entry)
  691.               (cons (nth 0 entry)
  692.                 (- (nth 2 entry) M)))
  693.             actives))))
  694.  
  695.     ;; Build the mapping table.
  696.     (setq nnvirtual-mapping-table nil)
  697.     (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
  698.     (while actives
  699.       (setq size (car actives))
  700.       (setq next-M (- M size))
  701.       (setq next-tot (- tot (* cnt size)))
  702.       ;; make current row in table
  703.       (push (vector M next-M cnt tot (- next-tot cnt))
  704.         nnvirtual-mapping-table)
  705.       ;; update M and tot
  706.       (setq M next-M)
  707.       (setq tot next-tot)
  708.       ;; subtract the current size from all entries.
  709.       (setq actives (mapcar (lambda (x) (- x size)) actives))
  710.       ;; remove anything that went to 0.
  711.       (while (and actives
  712.           (= (car actives) 0))
  713.     (pop actives)
  714.     (setq cnt (- cnt 1))))
  715.  
  716.  
  717.     ;; Now that the mapping tables are generated, we can convert
  718.     ;; and combine the separate component unreads and marks lists
  719.     ;; into single lists of virtual article numbers.
  720.     (setq unreads (apply 'nnvirtual-merge-sorted-lists
  721.              (mapcar (lambda (x)
  722.                    (nnvirtual-reverse-map-sequence
  723.                     (car x) (cdr x)))
  724.                  all-unreads)))
  725.     (setq marks (mapcar
  726.          (lambda (type)
  727.            (cons (cdr type)
  728.              (gnus-compress-sequence
  729.               (apply
  730.                'nnvirtual-merge-sorted-lists
  731.                (mapcar (lambda (x)
  732.                      (nnvirtual-reverse-map-sequence
  733.                       (car x)
  734.                       (cdr (assq (cdr type) (cdr x)))))
  735.                    all-marks)))))
  736.          gnus-article-mark-lists))
  737.  
  738.     ;; Remove any empty marks lists, and store.
  739.     (setq nnvirtual-mapping-marks nil)
  740.     (while marks
  741.       (if (cdr (car marks))
  742.       (push (car marks) nnvirtual-mapping-marks))
  743.       (setq marks (cdr marks)))
  744.  
  745.     ;; We need to convert the unreads to reads.  We compress the
  746.     ;; sequence as we go, otherwise it could be huge.
  747.     (while (and (<= (incf i) nnvirtual-mapping-len)
  748.         unreads)
  749.       (if (= i (car unreads))
  750.       (setq unreads (cdr unreads))
  751.     ;; try to get a range.
  752.     (setq beg i)
  753.     (while (and (<= (incf i) nnvirtual-mapping-len)
  754.             (not (= i (car unreads)))))
  755.     (setq i (- i 1))
  756.     (if (= i beg)
  757.         (push i reads)
  758.       (push (cons beg i) reads))
  759.     ))
  760.     (when (<= i nnvirtual-mapping-len)
  761.       (if (= i nnvirtual-mapping-len)
  762.       (push i reads)
  763.     (push (cons i nnvirtual-mapping-len) reads)))
  764.  
  765.     ;; Store the reads list for later use.
  766.     (setq nnvirtual-mapping-reads (nreverse reads))
  767.  
  768.     ;; Throw flag to show we changed the info.
  769.     (setq nnvirtual-info-installed nil)
  770.     ))
  771.  
  772. (provide 'nnvirtual)
  773.  
  774. ;;; nnvirtual.el ends here
  775.